home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_lists.m < prev    next >
Text File  |  1992-05-12  |  7KB  |  284 lines
  1. /*
  2.  *    Plurals
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:    mp_lists.m
  7.  *
  8.  *    Contents:    
  9.  *
  10.  *    Description:    A set of functions for creating and manipulatinh
  11.  *            cons cells in the usual lisp fashion
  12.  *
  13.  *    Change History:
  14.  *
  15.  *    Date   Name Comment
  16.  *    -------- ---- -------
  17.  *    23:04:91 SCM  Created
  18.  *
  19.  */
  20.  
  21. #include <mpl.h>
  22. #include <stdio.h>
  23.  
  24. #include "constant.h"
  25.  
  26. #include "mp_object.h"
  27. #include "mp_debug_off.h"
  28. #include "mp_type.h"
  29. #include "mp_mem_mgmt.h"
  30. #include "mp_gc.h"
  31.  
  32. typedef struct cons_cell_ {natural car;
  33.                natural cdr;
  34.              } cons_cell;
  35.  
  36. /*----------------------------------------------------------------------------*
  37.  * Function   : cons
  38.  *
  39.  * Parameters : MP_PluralHeap MPPH_car:    MasPar Plural Heap handles on car and
  40.  *        MP_PluralHeap MPPH_cdr:    cdr components of cons cell.
  41.  *        MP_PluralHeap MPPH_cell:    Resulting cons cell.
  42.  *
  43.  * Description:    Allocates a cons cell and sets the car and cdr to be 
  44.  *        those values given.
  45.  *
  46.  * Result     : int:    FAIL/SUCCESS
  47.  *---------------------------------------------------------------------------*/
  48.  
  49. #ifdef __STDC__
  50.  
  51. int cons( MP_PluralHeap MPPH_car, MPPH_cdr, MPPH_cell )
  52.  
  53. #else 
  54.  
  55. int cons( MPPH_car, MPPH_cdr, MPPH_cell )
  56.  
  57. MP_PluralHeap MPPH_car;
  58. MP_PluralHeap MPPH_cdr;
  59. MP_PluralHeap MPPH_cell;
  60.  
  61. #endif
  62.  
  63. {
  64.   plural cons_cell *plural new_cell;
  65.   plural natural temp;
  66.   MP_PluralHeap MPPH_temp;
  67. DBG_CALL("mp_cons");
  68. DBG_ARGS(DBG_PARG("MPPH_car","%x ",MPPH_car);DBG_PARG("\nMPPH_cdr","%x ",MPPH_cdr);DBG_PARG("\nMPPH_cell","%x ",MPPH_cell));
  69.  
  70.   /* Allocate space for cons cell */
  71.  
  72.   OA_to_offsets(MPPH_temp) = &temp;
  73.  
  74.   if (mp_alloc((plural int) MP_CONS, (plural int) 1, MPPH_temp) == FAIL) {
  75.  
  76. DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
  77.     return FAIL;
  78.   }
  79.  
  80. /*  new_cell = (plural cons_cell *plural) OA_data(MPPH_temp); */
  81. /*  new_cell->car = OA_offsets(MPPH_car); */
  82.  
  83.   *((plural natural *plural) OA_data(MPPH_temp)) = OA_offsets(MPPH_car);
  84.  
  85. DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));    
  86.  
  87.   
  88.   
  89.   *(((plural natural *plural) OA_data(MPPH_temp)) + 1) = (plural natural) OA_offsets(MPPH_cdr);
  90.  
  91. DEBUG(DBG_PARG("*","%d ",*(((plural natural *plural) OA_data(MPPH_temp))+1)));
  92. DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));    
  93. DEBUG(DBG_PARG("hs[2589]","%d ",heap_memory[2589]));
  94.   OA_offsets(MPPH_cell) = OA_offsets(MPPH_temp);
  95.  
  96. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  97.   return SUCCESS;
  98. }
  99.  
  100. /*----------------------------------------------------------------------------*
  101.  * Function   : car
  102.  *
  103.  * Parameters : MP_PluralHeap MPPH_cell:    Maspar Plural Heap handles on cons cell
  104.  *                    (we hope)
  105.  *        MP_PluralHeap MPPH_car:    Maspar Plural Heap handle on car
  106.  *                    
  107.  * Description:    Returns car of cons pairs in parallel.
  108.  *
  109.  * Result     : int:    SUCCESS/FAIL
  110.  *---------------------------------------------------------------------------*/
  111.  
  112. #ifdef __STDC__
  113.  
  114. int car( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_car )
  115.  
  116. #else
  117.  
  118. int car ( MPPH_cell, MPPH_car )
  119.  
  120. MP_PluralHeap MPPH_cell;
  121. MP_PluralHeap MPPH_car;
  122.  
  123. #endif
  124.  
  125. {
  126.   plural cons_cell *plural cell;
  127. DBG_CALL("car");
  128. DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_car=%04x",MPPH_cell,MPPH_car));
  129.  
  130.   cell = (plural cons_cell *plural) OA_data(MPPH_cell);
  131.  
  132.   /* Check these are all cons cells */
  133.  
  134.   if (globalor (OA_info(MPPH_cell) != MP_CONS)) {
  135.  
  136. DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
  137.     return FAIL;
  138.   }
  139.  
  140.   OA_offsets(MPPH_car) = cell->car;
  141.   
  142. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  143.   return SUCCESS;
  144. }
  145.  
  146. /*----------------------------------------------------------------------------*
  147.  * Function   : car
  148.  *
  149.  * Parameters : MP_PluralHeap MPPH_cell:    Maspar Plural Heap handles on cons cell
  150.  *                    (we hope)
  151.  *        MP_PluralHeap MPPH_cdr:    Maspar Plural Heap handle on cdr
  152.  *                    
  153.  * Description:    Returns cdr of cons pairs in parallel.
  154.  *
  155.  * Result     : int:    SUCCESS/FAIL
  156.  *---------------------------------------------------------------------------*/
  157.  
  158. #ifdef __STDC__
  159.  
  160. int cdr( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_cdr )
  161.  
  162. #else
  163.  
  164. int cdr ( MPPH_cell, MPPH_cdr )
  165.  
  166. MP_PluralHeap MPPH_cell;
  167. MP_PluralHeap MPPH_cdr;
  168.  
  169. #endif
  170.  
  171. {
  172.   plural cons_cell *plural cell;
  173. DBG_CALL("cdr");
  174. DBG_ARGS(DBG_PARG("MPPH_cell","%04x ",MPPH_cell);
  175.      DBG_PARG(", MPPH_cdr","%04x ",MPPH_cdr));
  176.  
  177.   cell = (plural cons_cell *plural) OA_data(MPPH_cell);
  178.  
  179.   /* Check these are all cons cells */
  180.  
  181.   if (globalor (OA_info(MPPH_cell) != MP_CONS)) {
  182.  
  183. DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
  184.     return FAIL;
  185.   }
  186.  
  187.   OA_offsets(MPPH_cdr) = cell->cdr;
  188.   
  189. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  190.   return SUCCESS;
  191. }
  192.  
  193. /*----------------------------------------------------------------------------*
  194.  * Function   : rplac_a
  195.  *
  196.  * Parameters : MP_PluralHeap MPPH_cell:    cell to have car changed
  197.  *        object MPP_new_car:    new value of car
  198.  *
  199.  * Description: Takes a cons cell and changes the existing value of car to
  200.  *        the given new value
  201.  *
  202.  * Result     : int SUCCESS/FAIL
  203.  *---------------------------------------------------------------------------*/
  204.  
  205. #ifdef __STDC__
  206.  
  207. int rplac_a( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_new_car )
  208.  
  209. #else
  210.  
  211. int rplac_a( MPPH_cell, MPPH_new_car )
  212.  
  213. MP_PluralHeap MPPH_cell;
  214. MP_PluralHeap MPPH_new_car;
  215.  
  216. #endif
  217.  
  218. {
  219.   plural cons_cell *plural cell;
  220. DBG_CALL("rplac_a");
  221. DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_new_car=%04x",MPPH_cell,MPPH_new_car));
  222.  
  223.   cell = (plural cons_cell *plural) OA_data(MPPH_cell);
  224.  
  225.   /* Check these are all cons cells */
  226.  
  227.   if (globalor (OA_info(MPPH_cell) != MP_CONS)) {
  228.  
  229. DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
  230.     return FAIL;
  231.   }
  232.  
  233.   cell->car = OA_offsets(MPPH_new_car);
  234.  
  235. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  236.   return SUCCESS;
  237. }
  238.  
  239. /*----------------------------------------------------------------------------*
  240.  * Function   : rplac_d
  241.  *
  242.  * Parameters : MP_PluralHeap MPPH_cell:    cell to have cdr changed
  243.  *        object MPP_new_cdr:    new value of cdr
  244.  *
  245.  * Description: Takes a cons cell and changes the existing value of cdr to
  246.  *        the given new value
  247.  *
  248.  * Result     : int SUCCESS/FAIL
  249.  *---------------------------------------------------------------------------*/
  250.  
  251. #ifdef __STDC__
  252.  
  253. int rplac_d( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_new_cdr )
  254.  
  255. #else
  256.  
  257. int rplac_d( MPPH_cell, MPPH_new_cdr )
  258.  
  259. MP_PluralHeap MPPH_cell;
  260. MP_PluralHeap MPPH_new_cdr;
  261.  
  262. #endif
  263.  
  264. {
  265.   plural cons_cell *plural cell;
  266. DBG_CALL("rplac_d");
  267. DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_new_cdr=%04x",MPPH_cell,MPPH_new_cdr));
  268.  
  269.   cell = (plural cons_cell *plural) OA_data(MPPH_cell);
  270.  
  271.   /* Check these are all cons cells */
  272.  
  273.   if (globalor (OA_info(MPPH_cell) != MP_CONS)) {
  274.  
  275. DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
  276.     return FAIL;
  277.   }
  278.  
  279.   cell->cdr = OA_offsets(MPPH_new_cdr);
  280.  
  281. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  282.   return SUCCESS;
  283. }
  284.